perm filename CODE4.F4[P11,LCS] blob
sn#592329 filedate 1981-06-06 generic text, type T, neo UTF8
00100 C****** CODE4.F4 DRAWS LINES, DASHES, ETC. *******
00220 C***** SUBROUTINE DASHLN
00240 C****** CRESC.F4 ---- HEAVY, HBRACK, CBRACK, RPDOT -----
00260 C TITLE ITMSUB
00300 C INTERNAL ITMSUB
00400 C EXTERNAL BM,NOZERO,LINX,ROFF,CENTX,STF,LINES,.COMM.
00500 C EXTERNAL DAT,RHORZ,CLEFS,PLTR,MIN,POSI,ALF,RDRAW,OLDTOP
00600 C DEFINE R9 <.COMM.+=10 >↔ DEFINE R8<.COMM.+=9 >
00700 C DEFINE J2 <.COMM.+3 >↔ DEFINE J10 <.COMM.+=31 >
00800 C DEFINE J7 <.COMM.+=28 >
00900 SUBROUTINE ITMSUB
01000 IMPLICIT INTEGER(A-Q,S-Z)
01100 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1,XDIS,OLDY
01200 COMMON/STF/RSTFAC(0/7),RSTJ2/MIN/MINI,RMINI
01300 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,DBR,RH/BM/RA,RC,RJY
01400 COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS,XDIS
01500 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01600 1 RJA,YY,DISX,HGT,RZ,INP(53) /OLDTOP/OLDY
01700 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(R11,
01800 1RJQ(9)),(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01900 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
02000 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
02100 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
02200 1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
02300 C RDBR IS SPACER FOR DBL BAR.
02400 RST7=RSTJ2*7.
02500 RST18=RSTJ2*18.
02600 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02700 R3Q=R3
02800 C NEXT DRAWS STRAIGHT LINES
02900 RD=R4*RST7
03000 RA=0
03100 RX=RTF*RSTJ2+POS
03200 J10=J10*DIS*RSTJ2
03300 C THICKNESS DEPENDS ON FINAL SIZE FACTOR (DIS) AND STAFF SIZE.(???!!)
03400 IF(J5.NE.50.AND.J5.NE.150)GO TO 300
03500 C 150 IS FOR 'PARTS' FEATURE - PUTS CRESC. IN ALL.
03600 CALL CRESC
03700 RETURN
03800 300 DBR=0
03900 IF(R6.NE.0)GO TO 401
04000 IF(J7.NE.0)GO TO 401
04100 C FOR BAR LINES
04200 JA=44
04300 C CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
04400 C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
04500 CC DBR=0
04600 IF(J4.LT.1000)GO TO 400
04700 C J4=1001 = DBL BAR, =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
04800 DBR=J4/1000
04900 J4=J4-DBR*1000
05000 C NOW J4 HAS 3 DIGITS, 1ST=THICKNESS, 3RD=NUMB. OF STAVES UP.
05100 IF(J5.NE.0)GO TO 9400
05200 IF(DBR.LT.2)GO TO 9400
05300 J5=1
05400 IF(DBR.EQ.4)DBR=1
05500 C FOR REPEAT DBL.BAR WITH P5=0
05600 C P4=2000=DOTS ON RIGHT, =3000=BOTH SIDES
05700 C =4000=DOTS ON LEFT
05800
05900 C DBR=1 HEAVY BAR IS ON RT
06000 9400 RD=RDBR+RDBR*RSTJ2
06100 C TO SPACE THIN BAR FROM HEAVY
06200 IF(J5.EQ.0)GO TO 400
06300 C NEXT ADDS REPEAT DOTS TO DBL BAR.
06400 CALL RPDOT
06500 GO TO 5400
06600 400 IF(J5.NE.0)GO TO 9400
06700 K=J4/100
06800 C K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
06900 J7=K*DIS
07000 C J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
07100 C5400 L=MOD(J4,100)
07200 C IF(J4.LT.0)J4=0
07300 C ABOVE FOR INVIS. BARS (AT PRINT TIME)
07400 5400 L=J4
07500 IF(L.LT.0)L=0
07600 L=MOD(L,100)
07700 IF(L.NE.0)L=L-1
07800 L=L+J2
07900 C L=L+J2-1
08000 C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
08100 RA=RTF
08200 IF(L.LE.7)GO TO 2400
08300 L=7
08400 RA=300.
08500 C FOR EXTENDING BARS ABOVE STAFF 7
08600 2400 OLDY=RSTFAC(L)
08700 C SAVE IT FOR DBL RPT BAR.
08800 RZ=R3Q
08900 OLDY=STFF(L)+(RA+56.)*OLDY
09000 1400 RA=1
09100 IF(PLT.GE.0)GO TO 140
09200 IF(J4.LT.0)RETURN
09300 J7=J7+1
09400 C DON'T PRINT INVIS BARS. (USED BY 'PAGE')
09500 RA=XDIS
09600 C BAR LINES PLOT AS DOUBLE THICKNESS
09700 140 RJX=R3Q
09800 42 CALL LINES(R3Q,RX,3)
09900 RJ=-1.
10000 RW=OLDY
10100 406 CALL LINES(RJX,OLDY,2)
10200 IF(J10.EQ.0)GO TO 411
10300 C P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
10400 J7=J10
10500 J10=0
10600 RA=XDIS
10700 411 IF(J7.LE.0)GO TO 409
10800 CALL HEAVY
10900 GO TO 42
11000 409 IF(DBR.LE.0)RETURN
11100 OLDY=RW
11200 RA=RZ-RD
11300 IF(DBR.NE.1)RA=RJX+RD-1.
11400 R3Q=RA
11500 DBR=DBR-2
11600 GO TO 1400
11700
11800 402 RJX=RJX+RA
11900 C HEAVIER BAR LINES
12000 CALL LINES(RJX,OLDY,2)
12100 J7=J7-1
12200 OLDY=RW
12300 IF(RJ.LT.0)OLDY=RX
12400 RJ=-RJ
12500 GO TO 406
12600 C DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
12700 1401 CALL HBRACK
12800 GO TO 2401
12900 C DASHES
13000 401 POS=POS-RST18
13100 IF(J7.LE.0)GO TO 407
13200 IF(J7.EQ.4)GO TO 1401
13300 IF(J7.NE.3)GO TO 4001
13400 C NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
13500 2401 JA=3
13600 IF(J10.EQ.0)J10=6.*DIS*RSTJ2
13700 C THICKNESS FOLLOWS PLOTTER SIZE AND STAFF SIZE
13800 C DEFAULT VALUE FOR THICKNESS =6*SIZE FACTS.
13900 R4=R4-RBR
14000 J9=0
14100 J5=35
14200 C THE NUM FOR THE LITTLE END ITEMS
14300 R6=3
14400 R7=0
14500 C DOES LOWER ONE FIRST. ITEM IS IN 'CLEFC.DMD' ON DAT.LCS
14600 R8=0
14700 C R8 MUST BE 0 FOR CLEFS (ELSE IT ACTIVATES THICKENER)
14800 JZ8=J8
14900 C SAVE J8 IN JZ8 (J8 WIPED OUT IN CLEFS)
15000 IF(J8.NE.2)CALL CLEFS
15100 C P8=1=BOTTOM 1/2 BRACK. ONLY: =2=TOP 1/2 ONLY: 0=COMPLETE
15200 R4=R5-RBR
15300 R6=3
15400 R7=-3
15500 C TURNS IT UPSIDE DOWN.
15600 IF(J7.NE.4)GO TO 3401
15700 POS=RA
15800 R4=R4*RJY/RSTJ2
15900 C TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
16000 3401 IF(JZ8.NE.1)CALL CLEFS
16100 C JZ8 IS CURRENTLY J8 (INTEGER I.E.)
16200 R3Q=R3Q-12.0*RSTJ2
16300 IF(J7.NE.4)GO TO 407
16400 J7=0
16500 GO TO 140
16600 4001 IF(J7.NE.5)GO TO 4002
16700 CALL CBRACK
16800 RETURN
16900 4002 CALL DASHLN
17000 RETURN
17100 407 RX=RD+POS
17200 OLDY=R5*RST7+POS
17300 R8=ABS(R8)
17400 C NO NEG, TOLERATED!!! 2/78
17500 IF(J7.EQ.3)GO TO 140
17600 CALL NOZERO(R9)
17700 IF(J7.EQ.-1)GO TO 408
17800 C FOR 'TR' J7=-2, 'ARPEGG' J7=-1, STRAIGHT LINES J7=0
17900 RJX=IFIX(ROFF(RHORZ(R6)))
18000 C ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
18100 IF(J7.EQ.0)GO TO 42
18200 OLDY=R9*RST7+RX
18300 CALL NOZERO(R8)
18400 4041 RZ=RX
18500 RH=OLDY
18600 C SAVE FOR THICK WIGGLES
18700 CALL LINES(R3Q,RX,3)
18800 C DRAWS STRAIGHT LINES. ETC.
18900 R9=R3Q
19000 RJ=OLDY
19100 RW=3.*RSTJ2*R8
19200 RA=RW*2.5
19300 C P8=HORZ. WIGGLE SIZE; P9=VERT. SIZE
19400 404 R9=R9+RA
19500 CALL LINES(R9,RJ,2)
19600 R9=R9+RW
19700 CALL LINES(R9,RJ,2)
19800 405 CALL EXCH(RX,RJ)
19900 IF(R9.LT.RJX)GO TO 404
20000 IF(J10.LE.0)RETURN
20100 OLDY=XDIS
20200 RX=RZ+OLDY
20300 OLDY=RH+OLDY
20400 J10=J10-1
20500 GO TO 4041
20600 C P10= + NUM OF THICKNESSES TO WIGGLE
20700 408 IF(RX.GT.OLDY)CALL EXCH(RX,OLDY)
20800 RZ=R9*RSTJ2*5.96
20900 C USE P9 TO SET WIGGLE WIDTH. P8 TO SET HGT.
21000 CALL NOZERO(R8)
21100 RD=R8*RST7*.5
21200 RJ=RD
21300 IF(RD.LT.1.)RD=1.
21400 421 R9=RX
21500 RW=R3Q
21600 RA=RZ+R3Q
21700 CALL LINES(RW,R9,3)
21800 410 R9=R9+RJ
21900 CALL LINES(RA,R9,2)
22000 R9=R9+RD
22100 CALL LINES(RA,R9,2)
22200 CALL EXCH(RA,RW)
22300 IF(R9.LT.OLDY)GO TO 410
22400 IF(J10.LE.0)RETURN
22500 R3Q=R3Q+XDIS
22600 J10=J10-1
22700 GO TO 421
22800 C VERTICAL WIGGLE P10=+ NUM OF THICKNESSES.
22900 END
23000
23100 SUBROUTINE DASHLN
23200 IMPLICIT INTEGER(A-Q,S-Z)
23300 REAL POS,XDIS,OLDY
23400 COMMON/STF/RSTFAC(0/7),RSTJ2
23500 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,DBR,RH/BM/RA,RC,RJY
23600 COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS,XDIS
23700 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
23800 1 RJA,YY,DISX,HGT,RZ,INP(53) /OLDTOP/OLDY
23900 EQUIVALENCE (J3,JQ(1)),(R5,RJQ(3)),(R11,
24000 1RJQ(9)),(R6,RJQ(4)),(J10,JQ(8))
24100 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
24200 1 ,(R4,RJQ(2)),(RX3,RJQ(20))
24300 4002 IF(R8.LE.0)R8=.8
24400 C NO NEG. NUMBS!!!! 2/78
24500 C P8 CAN SET SIZE OF DASH
24600 RZ=5.96*RSTJ2
24700 RJ=R8*RZ
24800 RZ=R9*RZ
24900 IF(R9.LE.0)RZ=RJ
25000 C P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)
25100 R8=RJ
25200 R9=RZ
25300 RD=RD+POS
25400 RJX=RD
25500 RJY=RD
25600 C =1 =DASHES, P6=P3=VERTICAL; P4=P5=HORIZ.; OTHERWISE SLOPE.
25700 J6=ROFF(RHORZ(R6))
25800 J3=J6-J3
25900 RJ4=R5-R4
26000 RA=J6
26100 C SAVE FOR THICK LINES
26200 C RA IS HORIZ. GOAL FOR DASHES
26300 OLDY=POS+R5*RST7
26400 IF(RJ4.EQ.0)GO TO 41
26500 RH=OLDY-RD
26600 C TOTAL HEIGHT DIFF.
26700 RX=RA-R3
26800 C TOTAL LENGTH DIFF.
26900 RH=RH/RX
27000 41 L=3
27100 K=2
27200 416 CALL LINES(R3Q,RD,L)
27300 IF(J3.EQ.0)GO TO 412
27400 C JUMP FOR VERT. DASH
27500 IF(J3.GT.0)GO TO 422
27600 IF(R3Q.LE.RA)GO TO 413
27700 C THIS IF P6 IS LESS THAN P3
27800 R3Q=R3Q-RJ
27900 GO TO 423
28000 422 IF(R3Q.GE.RA)GO TO 413
28100 C JUMP IF ALL DONE
28200 R3Q=R3Q+RJ
28300 423 IF(RJ4.NE.0)RD=RJY+RH*(R3Q-R3)
28400 C RJ4 HAS TILT
28500 C FINDS HEIGHT OF RIGHT SIDE OF SLOPE
28600 414 CALL EXCH(L,K)
28700 CALL EXCH(RJ,RZ)
28800 C EXCH. SPACE AND DASH SIZE.
28900 GO TO 416
29000 412 IF(RJ4.GT.0)GO TO 424
29100 IF(RD.LE.OLDY)GO TO 413
29200 RD=RD-RJ
29300 C THIS IF P5 IS LESS THAN P4.
29400 GO TO 414
29500 424 IF(RD.GE.OLDY)GO TO 413
29600 C JUMP IF DONE
29700 RD=RD+RJ
29800 GO TO 414
29900 413 IF(J10.GT.0)GO TO 420
30000 IF(J11.EQ.0)RETURN
30100 IF(J3)RJ=-RJ
30200 IF(L.EQ.3)R3Q=R3Q-RJ
30300 RX=R8
30400 IF(J11.LT.0)RX=-RX
30500 CALL LINX(R3Q,RD,R3Q,RD+RX)
30600 C PUTS BRACK END ON DASHED LINE. (P11=1 OR -1)
30700 RETURN
30800 C NEXT FOR THICK DASHES
30900 420 J10=J10-1
31000 RJ=XDIS
31100 IF(J3.EQ.0)GO TO 415
31200 R3Q=R3
31300 RJY=RJY+RJ
31400 RD=RJY
31500 GO TO 417
31600 415 R3Q=R3Q+RJ
31700 RD=RJX
31800 417 RJ=R8
31900 RZ=R9
32000 C FOR THICK DASHES.
32100 GO TO 41
32200 END
32300
35100 SUBROUTINE CRESC
35200 C DRAWS CRESC. AND RECTANGLES *****
35300 IMPLICIT INTEGER(A-Q,S-Z)
35400 REAL OLDY,STFF,XDIS
35500 COMMON /STF/RSTFAC(0/7),RSTJ2 /MIN/MINI,RMINI
35600 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16) /BM/RA,RC,RJY
35700 COMMON /POSI/STFF(0/7),JJ2,POS /PLTR/PLT,RHT,DIS,XDIS
35800 COMMON /ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
35900 1 RJA,YY,DISX,HGT,RZ,INP(53) /OLDTOP/OLDY
36000 EQUIVALENCE (R11,RJQ(9)),(R6,RJQ(4)),(J8,JQ(6)),(J10,JQ(8))
36100 1,(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1)),(R7,RJQ(5)),(R4,RJQ(2))
36200 300 IF(R7.EQ.0)R7=2.3
36300 IF(R7.EQ.-1.)R7=-2.3
36400 RA=ABS(R7/2.0)*RST7
36500 C AMOUNT OF SPREAD
36600 RJ=R3Q
36700 RX=RX-RST18+RD
36800 IF(R8.NE.0)GO TO 302
36900 C JUMP TO MAKE BOX
37000 R6=RHORZ(R6)
37100 IF(R7.LT.0)GO TO 301
37200 RJ=R6
37300 R6=R3Q
37400 301 CALL LINX(RJ,RA+RX,R6,RX)
37500 CALL LINES(RJ,RX-RA,2)
37600 C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
37700 IF(PLT.GE.0)RETURN
37800 C THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
37900 IF(J8.LT.0)RETURN
38000 RX=RX+XDIS
38100 J8=-1
38200 C FOR DOUBLE THICKNESS
38300 GO TO 301
38400 302 R8=R8*RST7
38500 R9=R9*RST7
38600 IF(R9.EQ.0)R9=R8
38700 C R9=0 MAKES SQUARE
38800 R3=R3Q-R8/2.
38900 RX=RX-R9/2.
39000 OLDY=RX
39100 IF(R11.NE.0)OLDY=OLDY+R11*RST7
39200 C R11 IS OFFSET FOR PARALLELAGRAM
39300 C DRAWS BOX, CENTER IS IN MIDDLE
39400 C 4,POSI+=9,STF,NT#,50,0,0,,SIZ1↑BY NT#S↑,SIZ2
39500 1302 CALL LINX(R3,RX,R3+R8,OLDY)
39600 CALL LINES(R3+R8,OLDY+R9,2)
39700 CALL LINES(R3,RX+R9,2)
39800 CALL LINES(R3,RX,2)
39900 IF(J10.EQ.0)RETURN
40000 J10=J10-1
40100 RJ=XDIS
40200 R3=R3-RJ
40300 R8=R8+RJ+RJ
40400 RX=RX-RJ
40500 OLDY=OLDY-RJ
40600 R9=R9+RJ+RJ
40700 GO TO 1302
40800 C TO THICKEN BOXES.
40900 END
41000
41100 SUBROUTINE HEAVY
41200 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16) /BM/RA,RC,RJY
41300 COMMON /ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
41400 1 RJA,YY,DISX,HGT,RZ,INP(53) /OLDTOP/OLDY
41500 EQUIVALENCE (R6,RJQ(4)),(J10,JQ(8)),(J7,JQ(5))
41600 C FOR 'HEAVY' LINE.
41700 C P10 = NUM. OF ADDITIONAL LINES.
41800 C ****** ONLY GOOD FOR SLOPE OF LESS THAN 45 DEG.
41900 J7=J7-1
42000 J10=J7
42100 C GET SHIFT INCREMENT (DEPENDS ON FINAL SIZE)
42200 RR=ABS(RX-OLDY)
42300 C RR HAS AMOUNT OF Y SHIFT IN LINE
42400 RQ=ABS(R3Q-RJX)
42500 C RQ HAS AMOUNT OF X SHIFT IN LINE
42600 RQ=RQ-RR
42700 IF(RQ.GE.0)GO TO 1402
42800 C MOVE RIGHT ONE SCAN LINE FOR NEXT VECTOR
42900 R3Q=R3Q+RA
43000 RJX=RJX+RA
43100 C R3Q AND RJX ARE THE 2 X COORDS.
43200 RETURN
43300 1402 RX=RX+RA
43400 C MOVE UP ONE SCAN LINE FOR NEXT VECTOR
43500 OLDY=OLDY+RA
43600 C RX AND OLDY ARE THE 2 Y COORDS.
43700 C GO DRAW IT
43800 END
43900
44000 SUBROUTINE HBRACK
44100 COMMON/STF/RSTFAC(0/7),RSTJ2
44200 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,DBR,RH/BM/RA,RC,RJY
44300 COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS,XDIS
44400 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
44500 1 RJA,YY,DISX,HGT,RZ,INP(53) /OLDTOP/OLDY
44600 EQUIVALENCE (J4,JQ(2)),(R5,RJQ(3)),(R6,RJQ(4)),(R4,RJQ(2))
44700 1401 R4=2.0
44800 C FOR HEAVY BRACK.
44900 RA=RST7
45000 RX=RX-RA
45100 C THE BOTTOM
45200 L=J4+J2-1
45300 R6=3.0
45400 IF(L.LE.7)GO TO 4401
45500 L=7
45600 R6=300.
45700 4401 RA=STFF(L)
45800 C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
45900 RJY=RSTFAC(L)
46000 OLDY=RA+(R6+63.)*RJY
46100 C THE TOP
46200 R5=9.5
46300 END
46400
46500 SUBROUTINE CBRACK
46600 COMMON /STF/RSTFAC(0/7),RSTJ2
46700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16)
46800 COMMON /POSI/STFF(0/7),JJ2,POS
46900 COMMON /ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
47000 1 RJA,YY,DISX,HGT,RZ,INP(53) /OLDTOP/OLDY
47100 EQUIVALENCE (J4,JQ(2)),(J5,JQ(3)),(R6,RJQ(4)),(J8,JQ(6))
47200 1,(R8,RJQ(6)),(R7,RJQ(5)),(R4,RJQ(2))
47300 J5=5
47400 C FOR CURVY BRACKET. P8 CAN CHANGE WIDTH.
47500 J4=J4+J2-1
47600 R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
47700 C .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
47800 C ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
47900 C ***** USE P8 FOR WIDTH FACTOR!! *****
48000 J8=0
48100 R6=R8
48200 R8=0
48300 IF(R6.EQ.0)R6=1.+R6/20.
48400 JA=3
48500 R4=2.3
48600 C BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*↑
48700 CALL CLEFS
48800 END
48900
49000 SUBROUTINE RPDOT
49100 C PUTS IN DOTS ON DOUBLE-BAR REPEATS
49200 IMPLICIT INTEGER(A-Q,S-Z)
49300 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1,XDIS
49400 COMMON/STF/RSTFAC(0/7),RSTJ2
49500 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,DBR,RH/BM/RA,RC,RJY
49600 COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS,XDIS
49700 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
49800 1 RJA,YY,DISX,HGT,RZ,INP(53)
49900 COMMON/DAT/RACNT(69),RDOT(17)
50000 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
50100 1,(J7,JQ(5)),(R3,RJQ(1))
50200 L=J4
50300 C SAVE J4 IN L UNTIL END
50400 RJ=L/100
50500 IF(RJ.EQ.0)RJ=6.*RSTJ2
50600 C HEAVY BAR WILL BE 5 LINES WIDE.
50700 RZ=R3
50800 J4=0
50900 C MUST BE 0 FOR DOTS IN 'NOTWRT'
51000 IF(DBR.NE.0)GO TO 2
51100 IF(J5.GT.3)J5=3
51200 DBR=J5
51300 2 J5=0
51400 C J5=1 RPT ↑, =2 RPT ↑, =3 RPT ↑
51500 RJA=RD*2.
51600 C TO SPACE DOTS, NOT ACCURATE FOR VERY SMALL OR VERY LARGE SIZE FACTORS
51700 JY=DBR
51800 IF(DBR.LT.2)GO TO 8400
51900 R3=RJA+RJ+RZ
52000 7400 DO 3400 K=J2,MOD(L,100)+J2-1
52100 C PUT DOTS ON ALL STAVES COVERED BY BAR LINE.
52200 4 RSTJ2=RSTFAC(K)
52300 POS=STFF(K)
52400 R4=6
52500 CALL CENTX
52600 C SPACES DOTS OUT FROM BAR
52700 CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
52800 C /DAT/+=69 ;EXTENDED FOR +65 TO +69 1/78
52900 C GO GET THE DOT
53000 R4=8
53100 CALL CENTX
53200 3400 CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
53300 JY=JY-1
53400 IF(JY.LT.2)GO TO 4400
53500 8400 R3=RZ-RJA-4.*RSTJ2
53600 GO TO 7400
53700 C DO I NEED ANY MORE RESETS????
53800 4400 J4=L
53900 J7=RJ*DIS
54000 END